home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / boxer / boxer.lha / comdef.lisp < prev    next >
Text File  |  1993-07-17  |  7KB  |  211 lines
  1. ;; -*- Mode:LISP; Package:(BOXER GLOBAL 1000); Base:8. ; Fonts:cptfont, cptfontb -*-
  2.  
  3. #|
  4.             Copyright 1985 Massachusetts Institute of Technology
  5.  
  6.  Permission to use, copy, modify, distribute, and sell this software
  7.  and its documentation for any purpose is hereby granted without fee,
  8.  provided that the above copyright notice appear in all copies and that
  9.  both that copyright notice and this permission notice appear in
  10.  supporting documentation, and that the name of M.I.T. not be used in
  11.  advertising or publicity pertaining to distribution of the software
  12.  without specific, written prior permission.  M.I.T. makes no
  13.  representations about the suitability of this software for any
  14.  purpose.  It is provided "as is" without express or implied warranty.
  15.  
  16.  
  17.                                           +-Data--+
  18.                  This file is part of the | BOXER | system
  19.                                           +-------+
  20.  
  21.  
  22.  This file contains Macros and Variable Declarations for BOXER Editor Commands 
  23.  
  24.  
  25. |#
  26.  
  27. (DEFVAR *BOXER-EDITOR-COMMANDS* NIL
  28.   "A list of all the commands used in the editor. ")
  29.  
  30. (DEFUN INITIALIZE-EDITOR ()
  31.   (SETQ *COLUMN*                  0)
  32.   (RESET-EDITOR-NUMERIC-ARG)
  33.   (UNLESS (NULL (OR *REGION-BEING-DEFINED* (GET-CURRENT-REGION)))
  34.     (FLUSH-REGION (OR *REGION-BEING-DEFINED* (GET-CURRENT-REGION)))))
  35.  
  36.  
  37.  
  38. ;;;; Utilities for Numeric args
  39.  
  40. (DEFVAR *EDITOR-NUMERIC-ARGUMENT* NIL
  41.   "Stores the value of whatever numeric argument for an editor function has accumalated. ")
  42.  
  43. (DEFMACRO WITH-MULTIPLE-EXECUTION (&BODY BODY)
  44.   ;; this is for turning single execution coms into ones that will take numeric arguments
  45.   `(UNWIND-PROTECT
  46.        (IF (NULL *EDITOR-NUMERIC-ARGUMENT*)
  47.        (PROGN ,@BODY)
  48.        (DOTIMES (I *EDITOR-NUMERIC-ARGUMENT*)
  49.          . ,BODY))
  50.      (RESET-EDITOR-NUMERIC-ARG)))
  51.  
  52. (DEFUN RESET-EDITOR-NUMERIC-ARG ()
  53.   (SETQ *EDITOR-NUMERIC-ARGUMENT* NIL)
  54.   (REDRAW-STATUS-LINE))
  55.  
  56. (DEFUN SET-EDITOR-NUMERIC-ARG (NEW-ARG)
  57.   (SETQ *EDITOR-NUMERIC-ARGUMENT* NEW-ARG)
  58.   (REDRAW-STATUS-LINE))
  59.  
  60. (DEFUN BOXER-KEY-NAME? (NAME)
  61.   (OR (STRING-SEARCH "-KEY" (STRING NAME))
  62.       (STRING-SEARCH "MOUSE-" (STRING NAME))))
  63.  
  64. (DEFUN BOXER-EDITOR-COMMAND? (COM)
  65.   (MEMQ COM *BOXER-EDITOR-COMMANDS*))
  66.  
  67. (DEFUN BOXER-COMMAND-DEFINE (COM-NAME DOC-STRING)
  68.   (UNLESS (BOXER-EDITOR-COMMAND? COM-NAME)
  69.     (PUSH COM-NAME *BOXER-EDITOR-COMMANDS*))
  70.   (IF (STRINGP DOC-STRING)
  71.       (PUTPROP COM-NAME DOC-STRING 'EDITOR-DOCUMENTATION)
  72.       (FERROR "Boxer Editor Commands Require a Documentation String. ")))
  73.  
  74. (DEFMACRO DEFBOXER-COMMAND (COM-NAME ARGS DOC-STRING . BODY)
  75.   `(PROGN 'COMPILE
  76.      (BOXER-COMMAND-DEFINE ',COM-NAME ',DOC-STRING)
  77.      (DEFUN ,COM-NAME ,ARGS
  78.      ,DOC-STRING
  79.      (*CATCH 'BOXER-EDITOR-TOP-LEVEL
  80.        . ,BODY))))
  81.  
  82. ;;; Editor no nos
  83. ;;; beeps for now but should be more informative in the future
  84. ;;; in the future, should do something with a string arg
  85.  
  86. ;;; Use BOXER-EDITOR-ERROR for unanticipated problems with allowed usage
  87. ;;; for example, a string search that fails
  88. (DEFUN BOXER-EDITOR-ERROR (STRING)
  89.   STRING                    ;bound but never used....
  90.   (BEEP))
  91.  
  92. (DEFMACRO EDITOR-BARF (STRING . ARGS)
  93.   `(FERROR ,STRING . ,ARGS))
  94.  
  95.  
  96.  
  97. ;;;; Useful information about where you are
  98.  
  99. (DEFUN BOX-POINT-IS-IN()          ;returns the box the bp part of
  100.   (BP-BOX *POINT*))              ;*point* refers to
  101.  
  102. (DEFUN SCREEN-BOX-POINT-IS-IN ()      ;returns the screen box the *point* is in
  103.   (POINT-SCREEN-BOX))
  104.  
  105. (DEFUN BOX-SCREEN-POINT-IS-IN ()      ;returns the box that the screen part of 
  106.   (TELL (POINT-SCREEN-BOX) :ACTUAL-OBJ))    ;*point* refers to
  107.  
  108.  
  109. (DEFUN BOX-POINT-IS-NEAR ()
  110.   (LET* ((ROW (BP-ROW *POINT*))
  111.      (CHA-NO (BP-CHA-NO *POINT*))
  112.      (CHA-BEFORE-BP (TELL ROW :CHA-AT-CHA-NO (- CHA-NO 1)))
  113.      (CHA-AFTER-BP  (TELL ROW :CHA-AT-CHA-NO CHA-NO)))
  114.     (COND ((BOX? CHA-AFTER-BP) CHA-AFTER-BP)
  115.       ((BOX? CHA-BEFORE-BP) CHA-BEFORE-BP)
  116.       (T NIL))))
  117.  
  118. (DEFUN SCREEN-BOX-POINT-IS-NEAR ()
  119.   (TELL (BOX-POINT-IS-NEAR) :ALLOCATE-SCREEN-OBJ-FOR-USE-IN
  120.                 (SCREEN-BOX-POINT-IS-IN)))
  121.  
  122.  
  123.  
  124. ;;;; Macros iterating over characters in a row
  125.  
  126. (DEFMACRO MAP-OVER-CHAS ((START-BP DIRECTION) &BODY BODY)
  127.   `(DO* ((ROW (BP-ROW ,START-BP) ROW)
  128.      (NEXT-OR-PREVIOUS-ROW (IF (PLUSP ,DIRECTION)
  129.                    (TELL-CHECK-NIL ROW :NEXT-ROW)
  130.                    (TELL-CHECK-NIL ROW :PREVIOUS-ROW))
  131.                    (IF (PLUSP ,DIRECTION)
  132.                    (TELL-CHECK-NIL ROW :NEXT-ROW)
  133.                    (TELL-CHECK-NIL ROW :PREVIOUS-ROW)))
  134.      (CHA-NO (BP-CHA-NO ,START-BP) (+ CHA-NO ,DIRECTION))
  135.      (CHA (TELL ROW :CHA-AT-CHA-NO (IF (PLUSP ,DIRECTION) CHA-NO (- CHA-NO 1)))
  136.           (TELL ROW :CHA-AT-CHA-NO (IF (PLUSP ,DIRECTION) CHA-NO (- CHA-NO 1)))))
  137.     (NIL)
  138.      (COND ((AND (NULL CHA) (NOT-NULL NEXT-OR-PREVIOUS-ROW))
  139.         (SETQ ROW NEXT-OR-PREVIOUS-ROW
  140.           CHA-NO (IF (PLUSP DIRECTION) 0
  141.                  (TELL NEXT-OR-PREVIOUS-ROW :LENGTH-IN-CHAS))))
  142.        (T
  143.         . ,BODY))))
  144.  
  145. (COMPILER:MAKE-OBSOLETE MAP-OVER-CHAS "Use MAP-OVER-CHAS-IN-LINE Instead. ")
  146.  
  147. (DEFMACRO MAP-OVER-CHAS-IN-LINE ((START-BP DIRECTION) &BODY BODY)
  148.   `(DO* ((ROW (BP-ROW ,START-BP) ROW)
  149.      (NEXT-OR-PREVIOUS-ROW (IF (PLUSP ,DIRECTION)
  150.                    (TELL-CHECK-NIL ROW :NEXT-ROW)
  151.                    (TELL-CHECK-NIL ROW :PREVIOUS-ROW))
  152.                    (IF (PLUSP ,DIRECTION)
  153.                    (TELL-CHECK-NIL ROW :NEXT-ROW)
  154.                    (TELL-CHECK-NIL ROW :PREVIOUS-ROW)))
  155.      (CHA-NO (BP-CHA-NO ,START-BP) (+ CHA-NO ,DIRECTION))
  156.      (CHA (TELL ROW :CHA-AT-CHA-NO (IF (PLUSP ,DIRECTION) CHA-NO
  157.                        (- CHA-NO 1)))
  158.           (TELL ROW :CHA-AT-CHA-NO (IF (PLUSP ,DIRECTION) CHA-NO
  159.                        (- CHA-NO 1)))))
  160.     (NIL)
  161.      (COND ((AND (NULL NOT-FIRST-CHA?)
  162.          (NULL CHA)
  163.          (NOT-NULL NEXT-OR-PREVIOUS-ROW))
  164.         (SETQ ROW NEXT-OR-PREVIOUS-ROW
  165.           CHA-NO (IF (PLUSP DIRECTION) 0
  166.                  (1+ (TELL NEXT-OR-PREVIOUS-ROW :LENGTH-IN-CHAS)))))
  167.        (T . ,BODY)))) 
  168.  
  169.  
  170.  
  171. ;;; For Killing stuff
  172.  
  173. ;for control-y
  174. (DEFSUBST KILL-BUFFER-TOP ()
  175.   (CAR *KILL-BUFFER*))
  176.  
  177. ;;;; Variables...
  178.  
  179. ;;; Used by the Kill stuff
  180. (defvar *kill-buffer-last-direction* nil)
  181.  
  182. (defvar *kill-buffer* (make-list 8))
  183.  
  184. (defvar *number-of-non-kill-commands-executed* 0)
  185.  
  186. ;;; Used by search
  187. (DEFVAR *CASE-AFFECTS-STRING-SEARCH* NIL)
  188.  
  189. ;;; Documantations VArs
  190.  
  191. (DEFVAR *TOP-LEVEL-HELP-BOX*
  192.     (MAKE-BOX '(("Type one of the following:")
  193.             ("A (Display commands with a given string)")
  194.             ("C (Document a Particular Command)")
  195.             (""))))
  196.  
  197. (DEFVAR *COMMAND-DOCUMENTATION-HELP-BOX*
  198.     (MAKE-BOX '(("Type a key to be documented: ")
  199.             ("")
  200.             (""))))
  201.  
  202. (DEFVAR *APROPOS-DOCUMENTATION-HELP-BOX*
  203.     (MAKE-BOX `(("APROPOS (Substring): ")
  204.             ("")
  205.             (""))))
  206.  
  207. ;;; Sprite commands use this one
  208. (DEFMACRO BOXER-TELLING (BOX-TO-DO IN-BOX)
  209.   `(WITH-STATIC-ROOT-BOUND (GET-LEXICAL-ROOT ,IN-BOX)
  210.      (EVAL-BOX-ROWS ,BOX-TO-DO)))
  211.